home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / ccontrl.exe / WNDFNPER.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-11-10  |  16.1 KB  |  448 lines
  1. {***************************************************************************
  2.  
  3.     Percent Control Window Procedure Unit        $Version$
  4.         Window Function Unit
  5.         $Author$        $Date$
  6.  
  7.         Copyright 1991 Anthony M. Vitabile
  8.  
  9.         Unit Description
  10.  
  11.         This Turbo Pascal for Windows unit contains the code that
  12.         implements the window function for a new kind of control window
  13.         for use in dialog boxes.  The behavior of the control is
  14.         determined by the code contained in this function.
  15.  
  16.         The library uses straight Windows calls and does NOT use Object-
  17.         Windows.  This is to allow the control to be used by ANY Windows
  18.         program.
  19.  
  20. ***************************************************************************}
  21.  
  22. Unit WndFnPercentCtrl;
  23. Interface
  24.   Uses WinTypes;
  25.  
  26.   function PercentCtrlWndFn(HWindow:  HWnd;
  27.                             Message,
  28.                             wParam :  word;
  29.                             lParam :  longint
  30.                            ):  longint; export;
  31.  
  32. Implementation
  33.   Uses CtrlCommonDefs, Strings, WinProcs;
  34.  
  35.   function GetPercentage(HWindow:  HWnd):  integer;
  36.     begin    { GetPercentage }
  37.       GetPercentage := GetWindowWord(HWindow, Pct_Percentage);
  38.     end        { GetPercentage };
  39.  
  40.   procedure DrawAxis(HWindow:  HWnd;
  41.                      DC     :  HDC;
  42.                  var Rect   :  TRect;
  43.                      BorderW:  integer;
  44.                      Style  :  longint);
  45.     var
  46.       Extent ,
  47.       i      ,
  48.       Mult   ,
  49.       NoTicks,
  50.       Percent,
  51.       X      :  word;
  52.       Width  :  single;
  53.       Txt    :  array [0 .. 3] of char;
  54.       Temp   :  string[3];
  55.  
  56.     begin    { DrawAxis }
  57.       if Style and Pct_Decades <> 0    { Determine how many points between ticks }
  58.        then Mult := 10
  59.        else
  60.         if Style and Pct_Quarters <> 0
  61.          then Mult := 25
  62.          else Mult := 50;
  63.       NoTicks := 100 div Mult;        { Determine the number of ticks on the bar }
  64.       Width   := (Rect.right - Rect.left - 2 * BorderW) / NoTicks;
  65.       X       := Rect.left + BorderW;
  66.       for i := 0 to NoTicks do
  67.         begin
  68.           Percent := i * Mult;        { Compute the current percentage to print }
  69.           Str(Percent:1, Temp);
  70.           StrPCopy(Txt, Temp);
  71.           Extent     := LoWord(GetTextExtent(DC, Txt, StrLen(Txt)));
  72.           Rect.left  := round(i * Width - Extent / 2) + X;
  73.           Rect.right := Rect.left + Extent;
  74.           DrawText(DC, Txt, 3, Rect, dt_Left)
  75.         end
  76.     end        { DrawAxis };
  77.  
  78.   procedure DrawShadow(HWindow:  HWnd;
  79.                        DC     :  HDC;
  80.                    var Rect   :  TRect;
  81.                        Up     :  boolean;
  82.                        Offset :  integer);
  83.     var
  84.       NewPen,
  85.       OldPen:  HPen;
  86.  
  87.     begin    { DrawShadow }
  88.       if Up                { Set up Working rectangle for drawing shadows, etc }
  89.        then NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_Window))
  90.        else NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_BtnShadow));
  91.       if NewPen = 0
  92.        then OldPen := 0
  93.        else OldPen := SelectObject(DC, NewPen);
  94.       MoveTo(DC, Rect.left  + (Offset + 1), Rect.bottom - (Offset + 2));
  95.       LineTo(DC, Rect.left  + (Offset + 1), Rect.top    + (Offset + 1));
  96.       LineTo(DC, Rect.right - (Offset + 2), Rect.top    + (Offset + 1));
  97.       MoveTo(DC, Rect.left  + (Offset + 2), Rect.bottom - (Offset + 3));
  98.       LineTo(DC, Rect.left  + (Offset + 2), Rect.top    + (Offset + 2));
  99.       LineTo(DC, Rect.right - (Offset + 3), Rect.top    + (Offset + 2));
  100.       if OldPen <> 0
  101.        then DeleteObject(SelectObject(DC, OldPen));
  102.       if Up                { Set up Working rectangle for drawing shadows, etc }
  103.        then NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_BtnShadow))
  104.        else NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_Window));
  105.       if NewPen = 0
  106.        then OldPen := 0
  107.        else OldPen := SelectObject(DC, NewPen);
  108.       MoveTo(DC, Rect.right - (Offset + 2), Rect.top    + (Offset + 1));
  109.       LineTo(DC, Rect.right - (Offset + 2), Rect.bottom - (Offset + 2));
  110.       LineTo(DC, Rect.left  + (Offset + 1), Rect.bottom - (Offset + 2));
  111.       MoveTo(DC, Rect.right - (Offset + 3), Rect.top    + (Offset + 2));
  112.       LineTo(DC, Rect.right - (Offset + 3), Rect.bottom - (Offset + 3));
  113.       LineTo(DC, Rect.left  + (Offset + 2), Rect.bottom - (Offset + 3));
  114.       if OldPen <> 0
  115.        then DeleteObject(SelectObject(DC, OldPen))
  116.     end        { DrawShadow };
  117.  
  118.   procedure DrawButton(HWindow:  HWnd;
  119.                        DC     :  HDC;
  120.                    var Rect   :  TRect;
  121.                        Up     :  boolean);
  122.     var
  123.       NewBrush,
  124.       OldBrush:  HBrush;
  125.       NewPen  ,
  126.       OldPen  :  HPen;
  127.       Offset  :  integer;
  128.  
  129.     begin    { DrawButton }
  130.       NewBrush := CreateSolidBrush(GetSysColor(color_BtnFace));
  131.       if NewBrush = 0            { Use the new brush if it was made }
  132.        then OldBrush := 0
  133.        else OldBrush := SelectObject(DC, NewBrush);
  134.       NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_WindowFrame));
  135.       if NewPen = 0
  136.        then OldPen := 0
  137.        else OldPen := SelectObject(DC, NewPen);
  138.       Rectangle(DC, Rect.left, Rect.top, Rect.right, Rect.bottom);
  139.       if OldBrush <> 0            { Restore the original brush now! }
  140.        then
  141.          begin
  142.            SelectObject(DC, OldBrush);
  143.            DeleteObject(NewBrush)
  144.          end;
  145.       if OldPen <> 0
  146.        then
  147.          begin
  148.            SelectObject(DC, OldPen);
  149.            DeleteObject(NewPen)
  150.          end;
  151.       if Up
  152.        then Offset := 0
  153.        else Offset := 2;
  154.       DrawShadow(HWindow, DC, Rect, Up, Offset)
  155.     end        { DrawButton };
  156.  
  157.   procedure DrawBar(HWindow:  HWnd; DC:  HDC; var Rect:  TRect);
  158.     var
  159.       Percent:  integer;
  160.       PctRect:  TRect;
  161.  
  162.     begin    { DrawBar }
  163.            { First draw the rectangle for the bar }
  164.       DrawButton(HWindow, DC, Rect, FALSE);
  165.  
  166.             { Draw the percentage rectangle }
  167.  
  168.       Percent := GetPercentage(HWindow);
  169.       if Percent > 0            { If there's something to be displayed }
  170.        then                { then draw the rectangle }
  171.          begin
  172.            PctRect := Rect;        { Percent rectangle is inside bar rectangle }
  173.            PctRect.right := PctRect.left   +    { Compute how far to the right the bar is! }
  174.                             round((Rect.right - Rect.left) *
  175.                                   GetPercentage(HWindow) / 100) + 1;
  176.            if PctRect.right > Rect.right
  177.              then PctRect.right := Rect.right;
  178.            DrawButton(HWindow, DC, PctRect, TRUE)
  179.         end
  180.     end        { DrawBar };
  181.  
  182.   procedure DrawDigits(HWindow:  HWnd; DC:  HDC; var Rect:  TRect);
  183.     var
  184.       i   :  integer;
  185.       Txt :  array [0 .. 4] of char;
  186.       Temp:  string[4];
  187.  
  188.     begin    { DrawDigits }
  189.       i := GetPercentage(HWindow);
  190.       Str(i:3, Temp);
  191.       Temp := Temp + '%';
  192.       StrPCopy(Txt, Temp);
  193.       i := SetBkMode(DC, Transparent);
  194.       DrawText(DC, Txt, length(Temp), Rect, dt_Center or dt_VCenter);
  195.       if i <> 0
  196.        then SetBkMode(DC, i)
  197.     end        { DrawDigits };
  198.  
  199.   procedure DrawTicks(HWindow:  HWnd;
  200.                       DC     :  HDC;
  201.                   var Rect   :  TRect;
  202.                       Style  :  longint);
  203.     var
  204.       i      ,
  205.       Mult   ,
  206.       NoTicks,
  207.       X      :  word;
  208.       Width  :  single;
  209.  
  210.     begin    { DrawTicks }
  211.       if Style and Pct_Decades <> 0    { Determine how many points between ticks }
  212.        then Mult := 10
  213.        else
  214.         if Style and Pct_Quarters <> 0
  215.          then Mult := 25
  216.          else Mult := 50;
  217.       NoTicks := 100 div Mult;        { Determine the number of ticks on the bar }
  218.       Width   := (Rect.right - Rect.left) / NoTicks;
  219.       for i := 0 to NoTicks do
  220.         begin
  221.           X := round(i * Width + Rect.left);
  222.           if (X >= Rect.right)
  223.            then X := Rect.right - 1;
  224.           MoveTo(DC, X, Rect.top);
  225.           LineTo(DC, X, Rect.bottom)
  226.         end
  227.     end        { DrawTicks };
  228.  
  229.   procedure DrawTitle(HWindow:  HWnd;
  230.                       DC     :  HDC;
  231.                   var Rect   :  TRect);
  232.     var
  233.       len :  integer;
  234.       Temp:  array [0 .. ctlTitle] of char;
  235.  
  236.     begin    { DrawTitle }
  237.       len := GetWindowText(HWindow, Temp, sizeof(Temp));
  238.       if len > 0
  239.        then DrawText(DC, Temp, len, Rect, dt_Center or dt_VCenter)
  240.     end        { DrawTitle };
  241.  
  242.   procedure EraseBackground(HWindow:  HWnd; DC:  hDC);
  243.     var
  244.       Brush ,
  245.       OBrush,
  246.       WBrush:  hBrush;
  247.       Parent:  HWnd;
  248.       CRect :  TRect;
  249.  
  250.     begin    { EraseBackground }
  251.       { First make sure we have the correct handle to restore at end! }
  252.       WBrush := GetStockObject(White_Brush);    { We may need this! }
  253.       OBrush := SelectObject(DC, WBrush);
  254.       Parent := GetParent(HWindow);
  255.       if Parent <> 0
  256.         then Brush := LoWord(SendMessage(Parent, wm_CtlColor, DC, MakeLong(HWindow, ctlcolor_Static)))
  257.         else Brush := WBrush;
  258.       UnrealizeObject(Brush);            { Align the brush pattern }
  259.       SelectObject   (DC, Brush);        { Select the brush }
  260.       GetClientRect  (HWindow, CRect);        { Get the area to be erased }
  261.       FillRect       (DC, CRect, Brush);    { Erase the background }
  262.       if Brush <> WBrush            { If the background isn't white, draw the shadow }
  263.         then DrawShadow(HWindow, DC, CRect, FALSE, 0);
  264.       DeleteObject(SelectObject(DC, OBrush))    { Restore the original brush }
  265.     end        { EraseBackground };
  266.  
  267.   procedure PaintPercentCtrl(HWindow:  HWnd);
  268.     var
  269.       HasAxis ,
  270.       HasPct  ,
  271.       HasTicks,
  272.       HasTitle:  boolean;
  273.       DC      :  HDC;
  274.       AxisH   ,
  275.       BarH    ,
  276.       BarW    ,
  277.       BorderW ,
  278.       CharH   ,
  279.       CharW   ,
  280.       Height  ,
  281.       TickH   ,
  282.       TitleH  ,
  283.       WhiteH  ,
  284.       Width   :  integer;
  285.       Style   :  longint;
  286.       Paint   :  TPaintStruct;
  287.       CRect   ,
  288.       Rect    :  TRect;
  289.  
  290.     begin    { PaintPercentCtrl }
  291.       DC := BeginPaint(HWindow, Paint);        { Begin the painting process }
  292.       GetClientRect(HWindow, CRect);        { Get the area covered by the window }
  293.       Style := GetDialogBaseUnits;        { Get the dialog base units }
  294.       CharH := HiWord(Style);            { Store the height of a character }
  295.       CharW := LoWord(Style);            { Store the width  of a character }
  296.  
  297.       { Set up the variables for drawing the 3 parts of the control }
  298.  
  299.       Height   := CRect.bottom - CRect.top;    { Compute the client rectangle's height }
  300.       Width    := CRect.right  - CRect.left;    { Compute the client rectangle's width }
  301.       Style    := GetWindowLong(HWindow, gwl_Style);    { Get the window's style bits }
  302.  
  303.       HasAxis  := Style and Pct_Axis   <> 0;
  304.       HasPct   := Style and Pct_Digits <> 0;
  305.       HasTicks := Style and (Pct_Decades or Pct_Quarters or Pct_Halves) <> 0;
  306.       HasTitle := GetWindowTextLength(HWindow) > 0;
  307.  
  308.       if not HasAxis                { Determine the width of the border }
  309.        then BorderW := 0
  310.        else BorderW := CharW * 5 div 2;
  311.       if BorderW >= Width div 4
  312.        then BorderW := 0;
  313.  
  314.       BarW := Width - BorderW * 2;        { Determine the width of the percentage bar }
  315.       if BarW < BorderW
  316.        then BarW := Width;
  317.  
  318.       if not HasAxis                { Determine the height of the axis }
  319.        then AxisH := 0
  320.        else AxisH := CharH;
  321.       if not HasTicks                { Determine the height of the ticks }
  322.        then TickH := 0
  323.        else TickH := CharH div 2;
  324.       WhiteH := CharH div 4;            { Compute white space height }
  325.       if not HasTitle
  326.        then TitleH := 0
  327.        else TitleH := CharH;
  328.  
  329.       BarH := Height;                { Compute bar height }
  330.       if HasTitle and                { If the control has a title }
  331.          (BarH - TitleH - WhiteH * 2 > 0)    { And it fits in the space we have }
  332.        then BarH := BarH - TitleH - WhiteH * 2;{ Then adjust the bar height for the title }
  333.       if HasTicks and                { If the control has tick marks }
  334.          (BarH - TickH - WhiteH div 2 > 0)    { And they fit in the space we have }
  335.        then BarH := BarH - TickH - WhiteH div 2;{ Then adjust the bar height for the tick marks }
  336.       if HasAxis and                { If the control has an axis }
  337.          (BarH - AxisH - WhiteH > 0)        { And it fits in the space we have }
  338.        then BarH := BarH - AxisH - WhiteH;
  339.  
  340.                                 { Draw the Title }
  341.  
  342.       Rect.top    := CRect.top;            { Compute the top    coordinate of the rectangle }
  343.       Rect.left   := CRect.left  + BorderW;    { Compute the left   coordinate of the rectangle }
  344.       Rect.right  := CRect.right - BorderW;    { Compute the right  coordinate of the rectangle }
  345.       if HasTitle
  346.        then
  347.         begin
  348.          Rect.top    := Rect.top + WhiteH;    { Compute the top    coordinate of the Title rectangle }
  349.          Rect.bottom := Rect.top + TitleH;    { Compute the bottom coordinate of the Title rectangle }
  350.          DrawTitle(HWindow, DC, Rect);
  351.          Rect.top := Rect.bottom + WhiteH    { Prepare the top    coordinate of the bar rectangle }
  352.         end;
  353.  
  354.                       { Draw the % bar }
  355.  
  356.       Rect.bottom := Rect.top + BarH;        { Compute the bottom coordinate of the bar rectangle }
  357.       DrawBar(HWindow, DC, Rect);        { Draw the bar on the display }
  358.       if HasPct                    { Draw the percent digits if this style is on }
  359.        then
  360.         begin
  361.          Rect.top    := Rect.top +         { Compute the bounding rect for the percent display }
  362.                         (BarH - CharH) div 2;
  363.          Rect.bottom := Rect.top + CharH;
  364.          DrawDigits(HWindow, DC, Rect);
  365.          Rect.top := Rect.top -            { Restore the rectangle }
  366.                      (BarH - CharH) div 2
  367.         end;
  368.  
  369.       if HasTicks                { Draw the axis tickmarks }
  370.        then
  371.         begin
  372.          Rect.top    := Rect.top + BarH;    { Compute the top    coordinate of the ticks rectangle }
  373.          Rect.bottom := Rect.top + TickH;    { Compute the bottom coordinate of the ticks rectangle }
  374.          DrawTicks(HWindow, DC, Rect, Style)    { Draw the tick marks }
  375.         end;
  376.  
  377.       if HasAxis        { Draw the axis labels }
  378.        then
  379.         begin
  380.          Rect.top    := Rect.bottom +        { Compute the top    coordinate of the ticks rectangle }
  381.                         WhiteH div 2;
  382.          Rect.bottom := Rect.top + AxisH;    { Compute the bottom coordinate of the ticks rectangle }
  383.          Rect.left   := CRect.left;
  384.          Rect.right  := CRect.right;
  385.          DrawAxis(HWindow, DC, Rect, BorderW, Style)    { Draw the axis labels }
  386.         end;
  387.  
  388.       EndPaint(HWindow, Paint)
  389.     end        { PaintPercentCtrl };
  390.  
  391.   procedure SetPercentage(HWindow:  HWnd; Pct:  integer);
  392.     begin    { SetPercentage }
  393.       SetWindowWord (HWindow, Pct_Percentage, Pct)
  394.     end        { SetPercentage };
  395.  
  396.   function PercentCtrlWndFn(HWindow:  HWnd;
  397.                             Message,
  398.                             wParam :  word;
  399.                             lParam :  longint
  400.                            ):  longint;
  401.     var
  402.       x     :  integer;
  403.       result:  longint;
  404.  
  405.     begin    { PercentCtrlWndFn }
  406.       result := ord(TRUE);
  407.       case Message of
  408.         wm_Create       :
  409.           begin
  410.             SetPercentage(HWindow, 0);
  411.             result := word(FALSE)
  412.           end;
  413.         wm_Paint        :  PaintPercentCtrl(HWindow);
  414.         wm_NCHitTest    :  result := htTransparent;
  415.         wm_EraseBkgnd   :  EraseBackground(HWindow, wParam);
  416.         pcm_ResetPercent:
  417.           begin
  418.             SetPercentage (HWindow, 0);
  419.             InvalidateRect(HWindow, nil, TRUE)
  420.           end;
  421.         pcm_AddPercent  :
  422.           begin
  423.             x := integer(wParam);
  424.             x := x + GetPercentage(HWindow);
  425.             if x < 0
  426.              then x := 0;
  427.             if x > 100
  428.              then x := 100;
  429.             SetPercentage (HWindow, x);
  430.             InvalidateRect(HWindow, nil, TRUE)
  431.           end;
  432.         pcm_GetPercent  : result := GetPercentage(HWindow);
  433.         pcm_SetPercent  :
  434.           begin
  435.             x := integer(wParam);
  436.             if x < 0
  437.              then x := 0;
  438.             if x > 100
  439.              then x := 100;
  440.             SetPercentage (HWindow, x);
  441.             InvalidateRect(HWindow, nil, TRUE)
  442.           end;
  443.        else result := DefWindowProc(HWindow, Message, wParam, lParam)
  444.       end;
  445.       PercentCtrlWndFn := result
  446.     end        { PercentCtrlWndFn };
  447.  
  448.   end.